Rozdział 5 - Graficzna prezentacja danych

Aby zainstalować i włączyć pakiet Przewodnik wykonaj poniższe dwie liniki.

devtools::install_github("pbiecek/PrzewodnikPakiet")
library("Przewodnik")

Kody z rozdziału 5. Graficzna prezentacja danych ,,Przewodnika po programie R’’ wydanie 4.

5.1. Znajdź siedem różnic

library("PBImisc")
plot(MDRD12~MDRD7, data = kidney) 

library("lattice")
xyplot(MDRD12~MDRD7, data = kidney) 

library("ggplot2")
qplot(MDRD7, MDRD12, data = kidney)

5.3. Pakiet lattice

library("PBImisc")
library("lattice")
xyplot(MDRD12 ~ MDRD7 | discrepancy.DR, data = kidney)

xyplot(MDRD12 ~ MDRD7 | discrepancy.DR, data = kidney, type=c("p","smooth","r"), col="grey", pch=16, ylab="MDRD 30d", xlab="MDRD 7d")

5.3.4. Panele i mechanizm warunkowania

histogram(~MDRD12 | therapy, data = kidney)

histogram(~MDRD12 | equal.count(donor.age,4), data = kidney)

5.3.5. Mechanizm grupowani

densityplot(~MDRD12, group = therapy, data = kidney,
plot.points = FALSE)

5.3.6. Legenda wykresu

densityplot(~MDRD12, group=therapy, auto.key = TRUE, data = kidney)

densityplot(~MDRD12, group=therapy, data = kidney, auto.key = list(space = "right", columns = 1))

5.3.7. Atlas funkcji graficznych z pakietu lattice

xyplot(MDRD12 + MDRD36 ~ MDRD7 | discrepancy.DR==0, data=kidney, type=c("p","smooth","g"), cex=0.5, auto.key = TRUE)

splom(kidney[,c(9,11,13,15)], type=c("smooth","p"), pch='.')

stripplot(factor(discrepancy.AB)~MDRD7, data = kidney, jitter.data = TRUE, alpha = 0.5)

discrepancy <- equal.count(kidney$discrepancy.AB, number=3)
bwplot(therapy~MDRD12|discrepancy, data=kidney, varwidth = TRUE)

library("Przewodnik")
(wPlec <- table(daneSoc$wyksztalcenie, daneSoc$plec))

##             
##              kobieta mezczyzna
##   podstawowe      22        71
##   srednie         16        39
##   wyzsze          10        24
##   zawodowe         7        15

dotplot(wPlec, groups=FALSE, origin=0, type = c("p","h"))

dotplot(wPlec, type="o", auto.key = list(space="right"))

attach(daneSoc)
tabela <- as.data.frame(table(wyksztalcenie, plec, praca ))
barchart(wyksztalcenie~Freq|plec, groups=praca, auto.key=TRUE, data=tabela)

parallel(~kidney[,c(9:16)], groups=MDRD7<30, data=kidney, alpha=0.2, horizontal.axis = FALSE, scales = list(x = list(rot = 90)))

histogram(~MDRD7 | therapy, data = kidney)

densityplot(~MDRD7 | factor(diabetes), groups=therapy, data=kidney, bw = 8, plot.points="rug", auto.key = TRUE)

library("latticeExtra")
ecdfplot(~MDRD7 | factor(diabetes), groups=therapy, data=kidney, auto.key=list(space="right"))

qq(diabetes ~ MDRD7 | therapy, distribution=qnorm, data=kidney)

qqmath( ~ MDRD7 | factor(diabetes), groups=therapy, data=kidney)

cloud(MDRD7 ~ MDRD30 + MDRD12 | diabetes, data = kidney)

library("MASS")
siatka <- kde2d(kidney$MDRD7, kidney$MDRD30, n=50)
siatka <- data.frame(expand.grid(MDRD7=siatka$x,MDRD30=siatka$y), z=c(siatka$z))
levelplot(z~MDRD7*MDRD30, siatka, cuts=20, colorkey=T,region=T)

contourplot(z~MDRD7*MDRD30, siatka, cuts=20)

wireframe(z ~ MDRD7 * MDRD30, siatka, cuts=20, shade=TRUE)

wireframe(z ~ MDRD7 * MDRD30, siatka, cuts=20, shade=FALSE)

5.3.8. Więcej o panelach

xyplot(Petal.Length ~ Sepal.Length | Species, data=iris, scales = list(x = "free", y = "sliced"))

tabela <- as.data.frame(table(daneSoc$wyksztalcenie, daneSoc$plec, daneSoc$praca))
wykres <- barchart(wyksztalcenie ~ Freq | plec, groups = praca, auto.key=TRUE, data=tabela)
wykres$panel

## [1] "panel.barchart"

nasz.panel <- function(..., border) {
  panel.grid(h=0, v=-1)
  panel.barchart(..., border="transparent")
  panel.text(list(...)$x+1, as.numeric(list(...)$y) -0.5 +
  as.numeric(list(...)$groups[list(...)$subscripts])/3,
  as.numeric(list(...)$x))
}
update(wykres, panel=nasz.panel, scales=list(x="free"), origin=0)

xyplot(cisnienie.skurczowe ~ cisnienie.rozkurczowe | plec,
  data = daneSoc,
  panel = function(x,y,...) {
    lpoints(cisnienie.rozkurczowe,cisnienie.skurczowe,
    pch=19, col='grey', cex=0.5)
    panel.xyplot(x,y,pch='+', cex=2)
  }
)

5.3.9. Motywy i parametry graficzne

trellis.par.get("plot.line")

## $alpha
## [1] 1
## 
## $col
## [1] "#0080ff"
## 
## $lty
## [1] 1
## 
## $lwd
## [1] 1

# trellis.par.set(plot.line = list(lwd = 3))

5.3.10. Zaawansowane opcje

wykres <- xyplot(MDRD7 ~ MDRD12, data = kidney, pch = 19)
plot(wykres, split = c(1,1,2,1))
plot(wykres, split = c(2,1,2,2), newpage = FALSE)
plot(wykres, split = c(3,2,4,2), newpage = FALSE)
plot(wykres, split = c(4,2,4,2), newpage = FALSE)

wykres <- xyplot(MDRD7 ~ MDRD12, data = kidney, pch = 19)
plot(wykres, position=c(0,0,.8,.8))
plot(wykres, position=c(0.35,0.35,.9,.9), newpage = FALSE)
plot(wykres, position=c(0.7,0.7,1,1), newpage = FALSE)

form <- sunspot.year~1:length(sunspot.year)
xyplot(form, type="l", aspect="xy", xlab="", subset=1:140)

xyplot(form, type="l", aspect="xy", xlab="", subset=141:280)

xyplot(MDRD12~MDRD7, kidney, pch=19, aspect="iso")

xyplot(MDRD12~MDRD7, kidney, pch=19, aspect="fill")

5.4. Pakiet ggplot2

5.4.1. Wprowadzenie

library("Przewodnik")
head(countries)

##               country birth.rate death.rate population continent
## 1         Afghanistan       34.1        7.7      30552      Asia
## 2             Albania       12.9        9.4       3173    Europe
## 3             Algeria       24.3        5.7      39208    Africa
## 4             Andorra        8.9        8.4         79    Europe
## 5              Angola       44.1       13.9      21472    Africa
## 6 Antigua and Barbuda       16.5        6.8         90  Americas

5.4.2. Warstwy wykresu

ggplot(countries, aes(birth.rate, death.rate)) +
  geom_point() +
  geom_smooth(se = FALSE, size = 3)

ggplot(countries, aes(x=continent, y=birth.rate, label=country))+
  geom_violin(aes(fill=continent)) +
  geom_jitter(position=position_jitter(width = .45)) +
  geom_rug(sides = "l")

5.4.3. Mapowanie zmiennych na atrybuty wykresu

ggplot(countries, aes(x = birth.rate, y = death.rate, 
                      color = continent, size = population)) +
      geom_point()

ggplot(countries, aes(x = birth.rate, y = death.rate,
                      color = birth.rate)) + geom_point(size=3)

5.4.4. Geometria warstwy

szkielet <- ggplot(countries, aes(continent, birth.rate, 
                                  color=continent, fill=continent))
szkielet + geom_point()

szkielet + geom_boxplot()

szkielet + geom_dotplot(binaxis = "y", stackdir = "center")

szkielet + geom_violin(scale="width")

5.4.5. Statystyki i agregacje

ggplot(countries, aes(continent)) + geom_bar()

ggplot(countries, aes(birth.rate, death.rate)) +
  geom_point() + geom_smooth() +
  geom_smooth(method="lm", se=FALSE, color="red", size=5)

5.4.6. Mechanizm warunkowania

ggplot(countries, aes(x = birth.rate, y = death.rate)) +
  stat_ellipse() + geom_point() +
  facet_grid(~continent)

ggplot(countries, aes(x = birth.rate, y = death.rate)) +
  geom_point(data=countries[,-5], size=0.5, color="grey") +
  stat_ellipse(color="red4") + geom_point(size=2, color="red") +
  facet_grid(~continent)

5.4.7. Kontrola skal

pl <- ggplot(countries, aes(x = birth.rate, y = death.rate, 
                            shape = continent)) + geom_point()
pl + scale_shape_manual(values = LETTERS)

pl + scale_shape_discrete(solid = FALSE)

pl <- ggplot(countries, aes(x = birth.rate, y = death.rate)) + 
  geom_point()
pl + scale_x_reverse() + scale_y_reverse()

pl + scale_x_continuous(breaks = c(1,2,5,10,20,50), limits=c(0,50))

5.4.8. Układ współrz˛ednych i osie wykresu

pl <- ggplot(countries, aes(x = birth.rate, y = death.rate)) +
  geom_point() + geom_smooth(se = FALSE, size = 2)
pl + coord_trans(y = "sqrt", x = "sqrt")

pl + coord_fixed()

pl + coord_flip()

5.4.9. Motywy i kompozycje graficzne

library("ggthemes")
pl + theme_bw() + ggtitle("theme_bw")

pl + theme_tufte() + ggtitle("theme_tufte")

5.4.10. Pozycjonowanie wykresów na rysunku

library(grid)
vp1 <- viewport()
vp2 <- viewport(width=0.4, height=0.4, x=0.75, y=0.7)
vp3 <- viewport(width=0.4, height=0.4, x=0.75, y=0.3)
print(pl, vp = vp1)
print(pl, vp = vp2)
print(pl, vp = vp3)

5.4.11. Obiekt klasy gg

class(pl)

## [1] "gg"     "ggplot"

summary(pl)

## data: country, birth.rate, death.rate, population, continent
##   [185x5]
## mapping:  x = birth.rate, y = death.rate
## faceting: <ggproto object: Class FacetNull, Facet>
##     compute_layout: function
##     draw_back: function
##     draw_front: function
##     draw_labels: function
##     draw_panels: function
##     finish_data: function
##     init_scales: function
##     map: function
##     map_data: function
##     params: list
##     render_back: function
##     render_front: function
##     render_panels: function
##     setup_data: function
##     setup_params: function
##     shrink: TRUE
##     train: function
##     train_positions: function
##     train_scales: function
##     vars: function
##     super:  <ggproto object: Class FacetNull, Facet>
## -----------------------------------
## geom_point: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identity 
## 
## geom_smooth: na.rm = FALSE
## stat_smooth: na.rm = FALSE, method = auto, formula = y ~ x, se = FALSE
## position_identity